home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / edit / me_cd25.zip / MUTT2.ZIP / QR.MUT < prev    next >
Text File  |  1992-11-09  |  7KB  |  254 lines
  1.   ;; qplace.mut : query replace
  2.   ;; Query replace: both regular expression and straight.
  3.   ;; Has popup documentation.
  4.   ;; Requires:
  5.   ;;   popup.mco
  6.   ;; C Durland    Public Domain
  7.  
  8. (string qr-search-pattern replace-pattern)
  9.  
  10. (defun
  11.   query-replace        ;; [ (string qr-search-pattern replace-pattern) ]
  12.   {
  13.     (if (== 2 (nargs))
  14.     {
  15.       (qr (arg 0) (arg 1) (floc search-forward) (floc replace-text))
  16.       (done)
  17.     })
  18.  
  19.     (if (and
  20.          (get-qr-search-pattern  "Query Replace"
  21.         qr-search-pattern replace-pattern)
  22.      (get-replace-pattern "New String"    replace-pattern))
  23.        (qr qr-search-pattern replace-pattern
  24.        (floc search-forward) (floc replace-text)))
  25.   }
  26.   re-query-replace    ;; [ (string qr-search-pattern replace-pattern) ]
  27.   {
  28.     (if (== 2 (nargs))
  29.     {
  30.       (qr (arg 0) (arg 1) (floc re-search-forward) (floc re-replace-text))
  31.       (done)
  32.     })
  33.  
  34.     (if (and
  35.          (get-qr-search-pattern  "RE Query Replace"
  36.         qr-search-pattern replace-pattern)
  37.      (get-replace-pattern "New String"     replace-pattern))
  38.        (qr qr-search-pattern replace-pattern
  39.        (floc re-search-forward) (floc re-replace-text)))
  40.   }
  41.   doc HIDDEN    ; popup a window with documentation
  42.   {
  43.     (menu-box
  44.     "Dot is left at the start of the search."
  45.     "Query replace commands:"
  46.     'q or ^G : Stop where you are, don''t go back to start.'
  47.     "y or Space : Replace this match and go to next one."
  48.     "n  : Skip to next match."
  49.     "!  : Replace all remaining matches without asking."
  50.     '^  : Move back to previous match.'
  51.     '^L : Redraw screen.'
  52.     "Period : Replace this match and stop."
  53.     "Comma  : Replace but don't move."
  54.     "Any other key:  stop the query replace and do the key."
  55.     )
  56.   }
  57.   MAIN
  58.   {
  59.     (require "menu-box" "popup")    ;; for (doc)
  60.   }
  61. )
  62.  
  63.  
  64. (const
  65.   QUIT                0    ;; ^G
  66.   BLAST-IT            1    ;; space, y
  67.   IGNORE-IT            2    ;; n
  68.   BLAST-THEM-ALL        3    ;; !
  69.   BLAST-IT-AND-STOP        4    ;; .
  70.   BACK-TO-LAST-MATCH        5    ;; ^
  71.   BLAST-IT-BUT-DON'T-MOVE    6    ;; ,
  72. )
  73.  
  74. (defun
  75.   qr
  76.     (string search-string new-text)
  77.     (pointer defun search-fcn replace-fcn)
  78.     HIDDEN
  79.   {
  80.     (bool stay-here keep-going not-yet-replaced at-end-goto-start)
  81.     (int replaced len mark-id)
  82.  
  83.     (mark-id (create-mark))
  84.     (replaced 0)
  85.     (len (length-of (search-string)))
  86.     (keep-going TRUE)(at-end-goto-start TRUE)
  87.  
  88.     (set-mark)                ;; remember where QR started
  89.     (while (and keep-going
  90.         {
  91.           (msg "Searching for " search-string " ...")
  92.           (set-mark mark-id)        ;; remember last match
  93.           (search-fcn search-string)    ;; find next match
  94.         })
  95.     {
  96.       (stay-here TRUE)(not-yet-replaced TRUE)
  97.       (while stay-here
  98.       {
  99.     (msg 'Query replacing "' search-string '" with "' new-text '"')
  100.     (update)    ;; make sure the cursor is in the correct place
  101.     (switch (ask-about-it)
  102.       QUIT (keep-going (stay-here (at-end-goto-start FALSE)))
  103.       IGNORE-IT (stay-here FALSE)
  104.       BLAST-IT
  105.         {
  106.           (if not-yet-replaced
  107.           {
  108.         (replace-fcn new-text len)
  109.         (+= replaced 1)
  110.           })
  111.           (stay-here FALSE)
  112.         }
  113.       BLAST-IT-AND-STOP
  114.         {
  115.           (if not-yet-replaced
  116.           {
  117.         (replace-fcn new-text len)
  118.         (+= replaced 1)
  119.           })
  120.           (stay-here (keep-going (at-end-goto-start FALSE)))
  121.         }
  122.       BLAST-IT-BUT-DON'T-MOVE
  123.         {
  124.           (if not-yet-replaced
  125.           {
  126.         (replace-fcn new-text len)
  127.         (+= replaced 1)
  128.         (not-yet-replaced FALSE)
  129.           })
  130.         }
  131.       BLAST-THEM-ALL    ;; replace 'till run out of things to replace
  132.         {
  133.           (while 
  134.           {
  135.         (replace-fcn new-text len)
  136.         (msg "Replacing ... [" (+= replaced 1) "]")
  137.         (search-fcn search-string)
  138.           } ())
  139.           (stay-here (keep-going FALSE))
  140.         }
  141.       BACK-TO-LAST-MATCH
  142.         {
  143.           (goto-mark mark-id)
  144.           (not-yet-replaced FALSE)
  145.         }
  146.     )        ;; end switch
  147.       })        ;; end while
  148.     }) ;; while
  149.  
  150.     (free-mark mark-id)
  151.  
  152.         ;; restore excursion & set mark at end of replace
  153.     (if at-end-goto-start (swap-marks))
  154.     (msg replaced " Strings Replaced.")
  155.     TRUE
  156.   }
  157.   ask-about-it    HIDDEN
  158.   {
  159.     (int keycode)
  160.  
  161.     (switch (keycode (get-key))
  162.       0x71  QUIT            ;; q
  163.       0x147 QUIT            ;; ^G
  164.       0x79  BLAST-IT            ;; y
  165.       0x20  BLAST-IT            ;; <space>
  166.       0x6E  IGNORE-IT            ;; n
  167.       0x2E  BLAST-IT-AND-STOP        ;; .
  168.       0x5E  BACK-TO-LAST-MATCH        ;; ^
  169.       0x2C  BLAST-IT-BUT-DON'T-MOVE    ;; ,
  170.       0x14C                ;; ^L : refresh screen
  171.     {
  172.       (refresh-screen)
  173.            ;; put cursor at right edge of screen
  174.       (window-ledge -1 (- (current-column)(screen-width) -1))
  175.       (update)
  176.       (msg "Still query replacing: (? for help)")(update)
  177.       (ask-about-it)
  178.     }
  179.       0x3F { (doc)(update)(refresh-screen)(ask-about-it) }   ;; ? - give doc
  180.       0x21 BLAST-THEM-ALL        ;; !
  181.       default                ;; execute the unknown key and quit
  182.     {
  183.       (exe-key keycode)
  184.       QUIT
  185.     }
  186.     )
  187.   }
  188.   get-qr-search-pattern (string prompt pattern replace-pattern-default) HIDDEN
  189.   {
  190.     (string pat)
  191.  
  192.     (pat (prompt-and-ask prompt pattern))
  193.     (if (== "" pat)        ;; user hit Enter so use default
  194.       {
  195.     (if (== "" pattern)    ;; no default
  196.       { (msg "Gotta search for something!") FALSE (done) })
  197.     ;; old pattern exists and is good so use it
  198.       }
  199.       (if (== "^W" pat)        ;; C-W => look for word cursor is on
  200.     {
  201.       (if (looking-at '\w+')
  202.         {
  203.           (replace-pattern-default "")  ;; clear replace pattern default
  204.           (pattern (get-matched '&'))   ;; use user entered pattern
  205.         }
  206.         { (msg "Not a word!") FALSE (done) })
  207.     }
  208.     {
  209.       (replace-pattern-default "")    ;; clear replace pattern default
  210.       (pattern pat)            ;; use user entered pattern
  211.     }))
  212.     TRUE
  213.   }
  214.   get-replace-pattern (string prompt pattern) HIDDEN
  215.   {
  216.     (string pat)
  217.  
  218.     (pat (prompt-and-ask prompt pattern))
  219.     (if (!= "" pat) (pattern pat))
  220.     TRUE
  221.   }
  222.   prompt-and-ask (string prompt pattern) HIDDEN
  223.   {
  224.     (ask-user)
  225.     (ask
  226.       prompt
  227.       (if (!= "" pattern)            ;; old pattern exists
  228.     (concat " [" pattern "]")        ;; prompt [pattern]:
  229.     "")
  230.       ": ")
  231.   }
  232. )
  233.  
  234. (defun
  235.   replace-text (string new-text) (int old-text-length) HIDDEN
  236.   {
  237.     (arg-prefix old-text-length)
  238.     (if (delete-previous-character)
  239.       { (insert-text new-text) TRUE }
  240.       (abort))
  241.   }
  242.   re-replace-text (string re-substitute) HIDDEN
  243.   {
  244.     (int n)
  245.  
  246.     (n (length-of (get-matched "&")))        ;; length of matched regexp
  247.     (arg-prefix n)(previous-character)        ;; move in front of matched
  248.     (insert-text (get-matched re-substitute))
  249.     (if { (arg-prefix n)(delete-character) }    ;; delete matched
  250.       TRUE
  251.       (abort))
  252.   }
  253. )
  254.